perm filename B[NEW,LCS] blob sn#519458 filedate 1980-07-01 generic text, type T, neo UTF8
C22	IF(J11.EQ.0)GO TO  122
CC	IF(MOD(J11,2).EQ.0)J11=J11+1
C MAKE SURE WE HAVE AN ODD NUMBER OF SEGMENTS FOR DASHES.
C	J11=3
C	KD=2
C	KT=0
C	KA=1
C THIS WILL MAKE DASHED SLURS  J11 HAS DASH SIZE.
C	DO 188 K=J6,J7,J5
C	KT=KT+1
C	IF(KT.LT.J11)GO TO 188
C	KT=0
C	KD=KD+KA
C	KA=-KA
C  BLANK-DASH FLIP-FLOP
C188	CALL LINES(SLURX(K),SLURY(K),KD)
C	GO TO 123

C122	DO 88 K=J6,J7,J5
C88	CALL LINES(SLURX(K),SLURY(K),2)
123	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C  DISPLAY END POINT OF SLUR
	IF(TWICE)RETURN
	TWICE=TWICE-1
	GO TO 182
180	RW=R+R7*RST7
	TWICE=-1
CC	KQ=1
	J5=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	RZ=RTILT/(RX-R3)
	TWICE=2
CC	RZ=RX-R3
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
	IF(R10.EQ.0)GO TO 87
C 1ST AND 2ND ENDING BRACKET.  P10=1 OR 2. YOU MUST SET OTHER PARAM.
C  ST P7=8  P8=1.  FOR 2ND ENDING USE P8=2
	R4=R4+R7-4.5
	R5=1. 
	RX=18.
	J3=R3+RX*RSTJ2
	R6=50003899.+R10*10000.
1181	CALL ALPHA
	J5=1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C  SIZE(R6) IS 0.875   R7=1 IS FOR ITALICS
	R7=1
	R8=0
	CALL MAKNUM(R9)
	END

	SUBROUTINE SCL
C  SETS UP SCALING MARKERS.
	COMMON /STF/RSTFAC(0/7),RSTJ2 /RINP/SU(900)
	COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
	1 /POSI/STFF(0/7),J102,POS
	J2=R2
	IF(J2.NE.99)GO TO 1008
	CALL HYDPOG(2)
	RETURN
1008	J5=0
	J6=0
	RSTJ2=RSTFAC(J2)
C  SETS UP SCALE LINES.
	J4=200
	IF(R3.NE.0)J4=400
C  PUTS SCALE TO 400
	R2=STFF(J2)+60.*RSTJ2
	RJ=R2+60.
	CALL DPYSET(2,SU,700)
	CALL DPYBRT(3)
	POS=RJ+40.
	RSTJ2=1.
	DO 1002 MX=10,J4,10
	RA=RHORZ(FLOAT(MX))
	R3=RA-58
	IF(MX.GT.10)CALL PNUM
CC1005	IF(R5.NE.0)GO TO 1007
C  JUMP FOR STAFF NUMBERS
	CALL LINX(RA,R2,RA,RJ)
	J5=J5+1
1002	IF(J5.EQ.10)J5=0
	CALL LINES(-596.0,RJ,2)
	CALL LINES(-596.0,R2,2)
	R6=1.5
C  NEXT SETS UP STAFF NUMBERS  TO FAR RIGHT(OUT OF WAY OF TYPING.)
	R3=615.
	DO 1007 K=0,7 
	POS=STFF(K)+40.
	J5=IABS(K)
	CALL PNUM
1007	CONTINUE
CC	CALL DPYDO(2)
  	CALL DPYOUT(2)
	CALL SETPOG(1)
	END

	FUNCTION IBLANK(IS,N)
	COMMON /XRN/RN(2000)